home *** CD-ROM | disk | FTP | other *** search
- {
- > Can someone please post some code on how to read a disk
- > label/serial number from a disk. I plan to use it as a copy
- > protection method (read the label/serial number on installation
- > and only the program to install on a drive the same
- > label/serial number) Thanks!
- }
-
- const BSize = 4096; { I/O Buffer Size }
- HexDigits: array[0..15] of char = '0123456789ABCDEF';
- type InfoBuffer = record
- InfoLevel : word; {should be zero}
- Serial : Longint;
- VolLabel : array[0..10] of Char;
- FileSystem : array[0..7] of Char
- end;
- SerString = String[9];
- DTA_Type = record
- Flag : byte;
- Res1 : array [1..5] of byte;
- Mask : Byte;
- Drive : Byte;
- Name : array [1..8] of Char;
- Ext : array [1..3] of char;
- Attrx : byte;
- Filler : array [12..21] of byte;
- Time,
- Date,
- Cluster,
- Size1,
- Size2 : integer;
- end;
- FCB_Type = record
- Flag : byte;
- Res1 : array [1..5] of byte;
- Mask : Byte;
- Drive : Byte;
- Name : array [1..8] of Char;
- Ext : array [1..3] of char;
- Current_Block,
- Record_Size,
- Size1,
- Size2,
- Date : integer;
- Filler : array [22..31] of byte;
- Record_No : byte;
- File_No_1,
- File_No_2 : integer
- end;
- DiskIDType = String[11];
- STR12 = string[12];
- STR8 = string[8];
- STR4 = string[4];
- MEDBUF = array[1..4096] of char;
- var Drive_Mask : byte;
- CH, CH1 : char;
- DEVICE : char; { Disk Device }
- BIN,BOUT,
- BWORK : ^MEDBUF;
- F : File;
- SNAME : String;
- DATE : string[8]; { formatted date as YY/MM/DD }
- TIME : string[5]; { " time as HH:MM }
- DISKNAME : string[15];
- GARB : string[6]; { extraneous device id }
- DirInfo : SearchRec; { File name search type }
- SR : SearchRec;
- DT : DateTime;
- PATH : PathStr;
- DIR : DirStr;
- FNAME : NameStr;
- EXT : ExtStr;
- FCB : FCB_Type;
- DTA : DTA_Type;
- Regs : Registers;
- Temp : String[1];
- DiskID : DiskIDType;
- NewDiskID : DiskIDType;
- BUFF : array[1..BSize] of Byte;
- IB : InfoBuffer;
- S : string[11];
-
- function SerialStr(L : longint) : SerString;
- var Temp : SerString;
- begin
- Temp[0] := #9;
- Temp[1] := HexDigits[L shr 28];
- Temp[2] := HexDigits[(L shr 24) and $F];
- Temp[3] := HexDigits[(L shr 20) and $F];
- Temp[4] := HexDigits[(L shr 16) and $F];
- Temp[5] := '-';
- Temp[6] := HexDigits[(L shr 12) and $F];
- Temp[7] := HexDigits[(L shr 8) and $F];
- Temp[8] := HexDigits[(L shr 4) and $F];
- Temp[9] := HexDigits[L and $F];
- SerialStr :=Temp;
- end;
-
- procedure INITS; { basic FCB, DTA initialization }
- begin
- Drive_Mask := Ord(DEVICE) - 64;
- with Regs do
- begin
- AH := $1A; DS := Seg(DTA); DX := Ofs(DTA); MSDOS (Regs);
- end;
- with FCB do
- begin
- Flag := $FF; Mask := $08;
- for I := 1 to 5 do
- Res1[I] := 0;
- Drive := Drive_Mask; Name := '????????'; Ext := '???';
- end;
- end; { INITS }
-
- function GetSerial(DiskNum : byte; var I : InfoBuffer) : word;
- assembler;
- asm
- MOV AH, 69h
- MOV AL, 00h
- MOV BL, DiskNum
- PUSH DS
- LDS DX, I
- INT 21h
- POP DS
- JC @Bad
- XOR AX, AX
- @Bad:
- end;
-
- function SetSerial(DiskNum : byte; var I : InfoBuffer) : word;
- Assembler;
- asm
- MOV AH, 69h
- MOV AL, 00h
- MOV BL, DiskNum
- PUSH DS
- LDS DX, I
- INT 21h
- POP DS
- JC @Bad
- XOR AX, AX
- @Bad:
- end;
-
- function GetDiskID (Drive : char): DiskIDType;
- var DirDiskID : STR12;
- PosPeriod : Byte;
- begin
- FindFirst (DEVICE+':\*.*',VolumeID,DirInfo);
- if DosError = 0 then
- begin
- DirDiskID := DirInfo.Name; PosPeriod := Pos('.',DirDiskID);
- if PosPeriod > 0 then System.Delete(DirDiskID,PosPeriod,1);
- GetDiskID := DirDiskID;
- GetSerial (Drive_Mask,IB); { Get Disk Serial# }
- end
- else GetDiskID := '';
- end; { GetDiskID }
-
- function SetDiskID (DiskID : DiskIDType): Boolean; { SET a volume label }
- begin
- with FCB do
- begin
- FillChar (Name[1],11,' '); { blank out name }
- Move (DiskID[1],Name[1],Length(DiskID));
- end;
- with Regs do
- begin
- AH := $16; DS := Seg(FCB); DX := Ofs(FCB);
- MsDos(Regs); SetDiskID := AL = 0
- end
- end; { SetDiskID }
-
- function DeleteDiskID : boolean; { DELETE a volume label }
- begin
- with Regs do
- begin
- AH := $13; DS := Seg(FCB); DX := Ofs(FCB);
- MsDos(Regs); DeleteDiskID := AL = 0;
- end
- end; { DeleteDiskID }
-
- function ReNameDiskID (NewDiskID : DiskIDType): Boolean; { RENAME a volume }
- begin
- if not DeleteDiskID then writeln ('Delete Error: ',Regs.AL);
- if not SetDiskID (NewDiskID) then writeln ('Rename error: ',Regs.AL);
- end; { RenameDiskID }
-
- procedure SetDiskInfo;
- begin
- with Regs do
- begin
- AH := $36; DL := Drive_Mask; MsDos(Regs);
- ASZ := LongInt(CX * AX) * DX; FSZ := LongInt(AX * CX) * BX;
- USZ := ASZ - FSZ; { amount free }
- end;
- end; { SetDiskInfo }
-